COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C  ********** DISPLAYS MUSIC AND DRAWS IT ON THE PLOTTER **********
C00022 00003	33	IF(X22.EQ.0)GO TO 6333
C00032 00004	60	J2=R2
C00044 ENDMK
C⊗;
C  ********** DISPLAYS MUSIC AND DRAWS IT ON THE PLOTTER **********
C *** READS DATA FROM CLEF0, BDR40,BDI40, ETC.

	IMPLICIT INTEGER(A-Q,S-Z)
	REAL DIS,DISX,A,B,STFF,CENTR,POS ,UD,XDIS
	COMMON /DL/X22,SAVER,NAME,EXT/RRJJ/RJJ2,RJJ(20)/FONT/JFONT
	DIMENSION LST(13),DP(0/7),LX(14),LY(6)
	COMMON/RINP/R(10,80),RPOS(2,50) /RMOD/RMODE2,RSET4,IBEAM,
	1 NOSET,STEM,STUP,NTC,ENDP,RAD,RDD,ITB,POSB
	COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK/SIZ/RSZ,JCEN,KCEN
C ORDER OF COMMON MUST! REMAIN AS IS (FOR DMP MODE READ)
	COMMON /STF/RSTFAC(0/7),RSTJ2 /POSI/STFF(0/7),JJ2,POS 
	COMMON/SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
	1/ALF/INP(72),ML /UPDWN/ RL,UD /LIMIT/LIMIT
	COMMON /PLTR/PLT,RHT,DIS,XDIS/PTR/PWDS(250),ITEM,L,I,IX
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
	COMMON/XRN/RN(2500)/DPY/ST(4000),WDS(250),MEDIT,IGO	
	EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3))
	1,(R6,RJQ(4)),(J10,JQ(8)),(J6,JQ(4)),(R4,RJQ(2)),(IT,LY(6))
	1,(R3,RJQ(1)),(I2,INP(2)),(I1,INP(1)),(LX(8),IL),(I3,INP(3))
	1,(R11,RJQ(9)),(NJR,R10,RJQ(8)),(R8,RJQ(6)),(RJ3,RJJ(1))
	1,(R9,RJQ(7)),(IR,LX(11)),(IU,LX(13)),(RX3,RJQ(20)),(IA,LX(1))
	1,(ST2,ST(2)),(IBL,LY(1)),(R13,RJQ(11)),(J13,JQ(11))
	1,(IE,LX(4)),(IP,LX(10)),(IM,LX(9)),(II,LX(6)),(IS,LX(12))
	1,(LX(2),ICC),(LX(5),IG),(LX(3),ID),(LX(14),IXX),(IPOS,POS)
	DATA STFF/-469.,-346.,-223.,-100.,23.,146.,269.,350./
	1 ,LST/'NOTE','REST','CLEF','LINE','SLUR',
	1 'BEAM','TRILL','STAFF','MISC','NUMB','WORD','KSIG','METER'/
	1,DP/8*1/,LX/'A','C','D','E','G','I','J','L','M','P','R',
	1 'S','U','X'/,LIMIT/2500/
	1,LY/' ','A','B','D','E','T'/, DIS/1.0/, RHT/1.0/
C LIMIT IS MAIN ARRAY LENGTH (2500)

	CALL SEGFIX
C  FOR UPPER SEGMENTS USED BY MORE THAN 1 JOB (SEGFIX.FAI[TVR])
CC	TYPE 9999
CC9999	FORMAT('   ****** NEW VERSION OF MS (3/77) ******'/
CC	1' IF INSURMOUNTABLE BUGS ARE ENCOUNTERED TRY'/
CC	1' MS.OLD AND MP.OLD (BOTH ON OLD,LCS) ')
	LCEN=0
	MCEN=0
CP	TOP2=-999
C  IF -1, THEN TRUE OUTLINES OF FONTS ARE DISPLAYED.
	I1=0
CP	DIS=1.
CP	RHT=1.
C  FOR 'FILLER' ON CRT.
2	CALL DPYSET(1,ST,4000)
	CALL HYDPOG(2)
	CALL HYDPOG(1)
	CALL TYPLOC(450,0)
	CALL DPYBRT(5)
	DO 299 K=1,I
CLEARS ARRAY FOR RESTART OF 'SETUP' ROUTINE
299	RN(K)=0
	JFONT=0
	IX=0
	RSET4=999
	QUICK=0
	UD=1
	RL=1
	FSCN=IL
	RPOS(1,1)=0
CP	PLOTIT=0
	RSZ=.845
CP	TOP=-999
CP	BOT=999
	X22=0
	JCEN=0
	KCEN=0
	PLT=0
	PWDS(1)=1
	EDX=-1
	RN(2)=0
C  FOR RESTART.  AVOIDS STAFF CODE NUM.
	SAVER=7
	DO 1402 K=0,7
1402	RSTFAC(K)=1.
	REDIT=999.
	M=1
	ITEM=0
	ZERO=-1
	WDS(1)=4
C  DATA IN DPY ARRAY STARTS AT WD.4!
	I=1
1100	SCORE=-1
58	IGO=-1
	IF(I1.NE.'R')GO TO 5505
CF	CALL FORMAT(NAME)
	I1=-1
	CALL NAMEXT(INP,NAME,EXT)
	IF(NAME.NE.IBL)GO TO 1221
C YOU CAN TYPE 'RS NAME' FOR QUICK RESTARTS
	GO TO 5505

11	CALL NOTWRT
CP57	IF(PLT)GO TO 6120
57	IF(M.GT.I)GO TO 571
	IF(IGO)CALL DPYOUT(1)
571	ITEM=ITEM+1
	IF(ITEM.LT.250)GO TO 17
	TYPE 170,ITEM
	I=PWDS(250)
	ITEM=249
	ST2=WDS(250)
	CALL DPYOUT(1)
	GO TO 1100
170	FORMAT(2(' **** TOO MANY ITEMS ',I3,'/249'/))
17	IF(IGO.GT.0)GO TO 20000
	K=ST2
	IF(X22.EQ.0)GO TO 20000
	CALL BOX(IBOX,RBOX)
	ST2=K
20000	WDS(ITEM+1)=ST2
	IF(EDX.EQ.-1)GO TO 1571
	IF(M.LT.I)GO TO 6120
CP1571	IF(PLOTIT.EQ.-2)GO TO 2311
C  SL=SAVE AFTER RESETTING LENGTH OF PAGE.  (SEE I2 IN SCX)
1571	PWDS(ITEM+1)=I
	PLT=0
	IF(IGO.NE.0)GO TO 55
	CALL DPYOUT(1)
	IF(SCORE.EQ.0)GO TO 9532
C  GO GET MORE FROM SCX.
	IGO=-1

55	IF(SCORE.EQ.0)GO TO 653
5505	SVST=ST2
C CATCHES TYPO WITH 'C'
	K=ITEM+1
	IF(X22.EQ.0)GO TO 5503
C 'N' SUPPRESSES TYPE-OUT, 'P' OR NEW ITEM RESTORES IT.
	IF(QUICK)5911,210,10
C -1=QUICK MODE, +1=SUPPRESS TYPE-OUT OF PARAMS
210	K=X22
	L=RN(MEDIT+1)
	IF(L.EQ.13)L=11
CC	IF(L.EQ.10)L=9
CC	IF(L.GE.16.AND.L.LE.18)L=L-5
	IF(L.GE.11)L=L-1
	IF(L.GE.15)L=L-4
CC	IF(L.EQ.20)L=12
	TYPE 427,LST(L),(RN(L),L=MEDIT+1,MEDIT+3)
	IF(YED.LT.2)GO TO 59
CP	IF(YED.LT.2)GO TO 5504
C   YED IS SET AT 426
	DO 5501 L=4,YED+2
5501	TYPE 4271,L,RN(MEDIT+L)
	GO TO 59

5919	FORMAT(' ;=LFT :=RT (=UP )=DN /=HALF *=*2'/)
591	QUICK=-1
	TYPE 5919
5911	CALL FSCAN
C FNUM.FAI=FAST COMMANDS ;=← :=→ (=↑ )=↓ /=HALF *=*2 X=X C=C OTHERS=CR
	GO TO 1591
	GO TO 2591
	GO TO 3591
	GO TO 4591
	GO TO 5913
	GO TO 6591
	GO TO 7591
	GO TO 5912
	I1=0
5591	QUICK=0
	GO TO 5917
5503	CALL HYDPOG(3)
C  TO DELETE VERTICAL LINE (55)
	KED=0
	QUICK=0
C  RESET PARAM TYPE-OUT
59	TYPE 56,NAME,K,I,SVST
10	JAB=JA
	SCORE=-1
	ACCEPT 89,INP
5917	DO 1313 L=1,14
1313	IF(I1.EQ.LX(L))GO TO 2313
	GO TO 310
C  'SA'=SAVE; 'S'=SET; 'SB'=SAVE BIG; 'ST'=STAFF; 
2313	IF(X22.NE.0)GO TO(884,883,883,5313,87,87,87,883,87,87,883
	1,15,883,883),L
CP	GO TO(87,13,7555,14,5313,120,884,7555,883,7555,311,883,15,883
	GO TO(13,7555,14,5313,120,87,7555,883,7555,87,883,15,883
	1,59),L
C               A  C   D   E   G   I   J    L   M   P   R   S  U(X
C  HERE A=ALTER A GROUP, DE=DELETE A GROUP
C  'DP'=DISPLAY OR HIDE WHICH STAVES.  D=DOWN N
14	IF(I2-IE)883,13,884
13	IF(I2.EQ.ID)GO TO 884
C  'AD' = ADJUST STEMS TO MEET BEAMS (CODE# 19)
	IGO=1
	CALL GRED
	JFONT=0
	IF(JA.EQ.98)GO TO 5533
	KNT=0
	SCORE=0
	GO TO 653

1591	I1=IL
9591	FSCN=I1
	GO TO 5917
2591	I1=IR
	GO TO 9591
3591	I1=IU
	GO TO 9591
4591	I1=ID
	GO TO 9591
7591	I1=IXX
	GO TO 5591
5912	I1=ICC
	GO TO 5591
5913	I1=FSCN
	IF(FSCN.EQ.IL)GO TO 5914
	IF(FSCN.EQ.IR)GO TO 5914
C NEXT FOR UP-DOWN
	UD=UD/2
	GO TO 5917
5914	RL=RL/2
	GO TO 5917
6591	I1=FSCN
	IF(I1.EQ.IL)GO TO 5916
	IF(I1.EQ.IR)GO TO 5916
	UD=UD*2
	GO TO 5917
5916	RL=RL*2
	GO TO 5917


C  'S'=SET, SA=SAVE, SB=SAVE BIG, SM=BIG+SAME NAME, ST=STAFF, SP=SPC STF.
C  SC=SPACING SCALE ABOVE STAFF n (99=DELETE IT)
15	DO 3313 L=1,6
3313	IF(I2.EQ.LY(L))GO TO(312,3121,3121,3121,312,884),L
C                               BL  A    B     D    E   T
	IF(I2.EQ.ICC)GO TO 884
	IF(I2.EQ.IP)GO TO 87
	IF(I2.EQ.'H')JFONT=1
	IF(I3.EQ.IXX)JFONT=0
	IF(I3.EQ.IP)JFONT=-1
	IF(I3.EQ.'O')JFONT=-2
	IF(I3.EQ.II)JFONT=-3
C  'SH'(=SHOW) IS SAME AS 44 1.  SHOWS TYPE FONTS ON DPY.
C  'SHP' = SHOW ONLY AS 'PRIMATIVE' FONT, 'SHX' = CANCEL FONTS ON DPY.
C  'SHO' = FONT SET (TEMPORARILY) TO 'BDR'; 'SHI' = 'BDI' (ITALICS)
	IF(I2.NE.IM)GO TO 5505
C  ONLY FOR ST, SA, SB, SM, RS, S
3121	IF(X22.NE.0)GO TO 5505
	SAVER=7
	CALL SAVIT
	GO TO 5505
312	JA=55
	R2=RN(MEDIT+3)
C  POSITION OF ITEM LOOKED AT.
	R3=55.
	GO TO 6531
C  ABOVE FOR 'S'ET ALIGNMENT
C  'S'=SET ALIGNMENT, 'A'=ALIGN IT.  'M'=MOVER 'C'= COPIER
C  'E'=EDIT; 'I'=ITEM; 'G'=GET; 'GM'=GET MORE;
CF5313	IF(I2.NE.IXX)GO TO 6313
CF	JA=EXT
C TYPE 'EXT NNN'  TO PUT .NNN AS EXTENSION ON OUTPUT FILES.(.DMD=DEFAULT)
CF	REREAD 1885,K,EXT
CF	IF(EXT.NE.IBL)GO TO 5505
CF	EXT=JA
C  TYPE 'EXT' ONLY TO SEE WHAT IS CURRENT EXT.
CF	TYPE 1885,IBL,EXT
CF	GO TO 5505
CF1885	FORMAT(A4,A3)
CF6313	K=-1
5313	K=-1
	DO 882 JA=3,10
882	IF(INP(JA).NE.IBL)GO TO 884
	GO TO 883
885	FORMAT(A2,21F)
884	REREAD 885,K,R2,RJQ
	JA=55
	IF(I2.NE.ICC)GO TO 101
	CALL SCL
	GO TO 5505
101	IF(I2.NE.ID)GO TO 988
	IF(I1.EQ.IA)JA=19
C  'AD'just stems to beams.
988	IF(I2.EQ.IT)JA=44
	IF(I2.EQ.'N')GO TO 188
	IF(I2.NE.IP)GO TO 6531
	IF(R2.GT.7)GO TO 1886
C  GO BACK AND RESET ALL IF STF NUM >7
	K=R2
	JA=0
C  USE '8' FOR STAFF 0.
888	IF(K.EQ.8)K=0
	DP(K)=-DP(K)
	JA=JA+1
	K=RJQ(JA)
	IF(K.EQ.0)GO TO 55
C  JUMP OUT IF RJQ(JA)=0 OR 99
	IF(K.EQ.99)GO TO 85
C*** 3/74  END WITH '99' TO MAKE DP RIGHT NOW!
	GO TO 888
C  TO GET BACK ALL LINES TYPE 6+
311	JA=0
	IGO=1
	ML=0
	IF(I2.NE.IL)GO TO 884
1886	DO 2886 K=0,7
2886	DP(K)=1
	GO TO 85
CP	IF(I1.NE.IP)GO TO 8851
C PL RESETS 'DP'
C  TO GET BACK OTHERS - 'DPY N' AGAIN WILL DO.
CP2311	CALL PLTCMD
CP	IF(PLOTIT.EQ.0)GO TO 3005
CP	I1=IP
CP	PLOTIT=-1
CP	GO TO 6531
C  'PL' GOES TO 'PLOT COMMAND' ROUTINE

881	IF(I1.GT.0)GO TO 87
C   JUMP IF I1 IS NOT A LETTER (K>0=NUM, K<0=LET.)

C NEXT FOR READ, RS, DEL, L,R,U,D
883	IF(I1.EQ.IR)GO TO 8835
	IF(IX.EQ.I)GO TO 8834
C  CAN'T DELETE ('DE') AFTER A PARAM HAS BEEN CHANGED. START OVER.
	IF(I2.NE.IE)GO TO 8831
	GO TO 5505
8835	IF(I2.EQ.IS)GO TO 2
C  TYPE 'RS' TO RESTART.
	IF(I2.NE.IE)GO TO 8831
C  'READ' IS SAME AS 144
	JA=144
	GO TO 88
8834	IF(I1.EQ.ICC)GO TO 72
8831	IF(JA.NE.16)GO TO 8832
	IF(X22.EQ.0)GO TO 5505
C  CAN'T MOVE LETTERS OR 'SCORE' ENTRIES UNLESS REALLY IN EDIT MODE!
8832	CALL EDIT(JJA)
	IF(JA.NE.99)GO TO 6531
	CALL DELETE
C  DELETE ROUTINE COULD BE PUT DIRECTLY IN HERE.
	GO TO 425
89	FORMAT(72A1)
C  TYPE L, R, U OR D OR EDIT TO MOVE LAST ENTERED ITEM.

310	IF(I1.EQ.'N')GO TO 410
	IF(X22.EQ.0)GO TO 87
	IF(I1.EQ.'Q')GO TO 591
	GO TO 87
410	IF(QUICK.NE.0)GO TO 510
C ↑↑↑ SO 'N n' WILL WORK EVEN AFTER N HAS BEEN SET.
	QUICK=1
C TYPE 'N'  =NO-TYPE PARAMS  TO SUPPRESS TYPE-OUT WHILE EDITING.
	IF(X22.NE.0)GO TO 87
510	I1=II
C  'N n' WHEN NOT IN EDIT MODE = 'I n'<CR>,'N'<CR>
87	REREAD 1,JA,R2,RJQ
	IF(I1.NE.II)GO TO 610
	IF(I2.EQ.'N')GO TO 884
C  'IN n,n,n,' MUST BE READ AGAIN AT 884 TO GET n'S CORRECTLY.
	JA=22
	GO TO 6531
610	IF(K)JA=55
C   ED 47 -1 = 55 47 -1, ETC.
	IF(JA.EQ.101)GO TO 101
CC	IF(JA.EQ.44)GO TO 221
CC	IF(JA.EQ.14)GO TO 88
C  IS THERE A BUG CONCERNING SAVIT AND 'SCORE'????
CC	IF(JA.EQ.144)GO TO 88
CC	IF(JA.EQ.444)GO TO 440
	IF(I1.NE.'N')GO TO 710
	IF(R2.NE.0)GO TO 510
C IF NO NUM FOLLOWS 'N' GO PRINT OUT CURRENT PARAMS.
	GO TO 10
710	IF(I1.EQ.'Z')GO TO 24
C  'Z' = ZOOM  (OLD CODE# 24)
	IF(I2.NE.IP)GO TO 441
	RSET4=R3
C SPn SETS "SETUP" STAFF NUMBER
	GO TO 5505
C  'SP' IS SAME AS 444
441	IF(I1.EQ.IP)GO TO 33
C  'P n' = PRINT CURRENT CONTENTS OF PARAM n. (ONLY WHILE IN EDIT MODE.)
	IF(I1.NE.IT)GO TO 110
	IF(X22.EQ.0)GO TO 288
	QUICK=0
C TYPE 'T' TO RESET PARAM TYPE-OUT
	IF(R2.EQ.0)GO TO 5505
	GO TO 510
110	IF(JA.GT.0)SAVER=SAVER-1
	IF(X22.NE.0)GO TO 6531
	IF(SAVER)CALL SAVIT
C  SAVES EVERY 7TH TIME AROUND
	IF(JA.EQ.0)GO TO 5505
C  CATCHES ZEROS AND LOWER CASE LETTERS.
	GO TO 6531
C NEXT FOR ALPHA TEXT ITEMS.  'T'=TYPE
288	JA=16
	M=I
	J2=R2
	CALL WORDS
	SAVER=SAVER-1
	GO TO 8852

CC188	R3=0
CC88	SET4=R3
C  *** THIS FEATURE CHNGD. 6/75***SET4 IS NEG. FOR AUTOMATIC STAFF 4 SETUP.
188	IF(X22.NE.0)GO TO 5505
	JA=14
	RMODE2=R3
C  TYPE 'IN STF# MODE' ETC.  -- SAME AS 14 STF#.
88	SCORE=0
	IF(JA.NE.14)GO TO 889
C NEXT PUTS UP STAFF IF IT WASN'T THERE ALREADY
	SAVER=-1
	RSTF=R2
	IF(R3)R3=0
	DO 1889 K=1,ITEM
	J=PWDS(K)
	IF(RN(J+1).NE.8)GO TO 1889
	IF(RN(J+2).EQ.R2)GO TO 890
1889	CONTINUE
C DIDN'T FIND THIS STAFF
	M=2000
	IGO=0
	JA=8
	R3=0
	GO TO 6531
890	JA=14
	ITCHK=ITEM
	ICHK=I
	IDPY=ST2
C ALL THIS FOR BACKUPS
889	SPD=ST2
	JIT=ITEM
	ISC=I
	REND=0
C   RETAINS ORIGINS OF SCORE SQUENCE
9532	IF(REND.EQ.2)GO TO 889
C  FOR READIN CONTINUATION.
	M=ISC
9533	IF(JA.EQ.8)GO TO 890
	IF(REND)GO TO 9535
C REND=0 GO,  -1=NORMAL END,  1=ABORTED.
	CALL SCMSS
	IF(REND.EQ.1)GO TO 9535
	IF(REND.NE.99)GO TO 9534
	I=ICHK
	ITEM=ITCHK
	ST2=IDPY
	CALL ACCPOG(1)
	CALL DPYOUT(1)
	GO TO 9535
9534	ITEM=JIT
	J=M
9536	ITEM=ITEM+1
	PWDS(ITEM)=J
	J=J+RN(J)+3
	IF(J.LT.I)GO TO 9536
	IF(IBEAM)GO TO 9537
	R13=0
	R2=RSTF
	JA=19
	J3=0
	CALL HOMER
9537	ITEM=JIT
	ST2=SPD
	GO TO 8852
9535	SCORE=-1
	CALL SHRINK(JIT)
C  GETS RID OF ZEROS AT END OF NOTE PARAM LIST.
	IGO=-1
	JA=16
C  FOR TRAP AT 'EDIT'
	GO TO 5505

CC553	IF(SCORE)GO TO 6531
653	KNT=KNT+1
C   NUM OF ITEMS IN LIST
	R11=0
	R10=0
	R9=0
	JA=R(1,KNT)
	R2=R(2,KNT)
	IF(JA.NE.0)GO TO 550
C  =0 MEANS NO MORE ITEMS.
	CALL DPYOUT(1)
	GO TO 1100

5533	X22=0
	IGO=-1
	CALL DPYNEW
	GO TO 55

550	DO 7531 K=1,6
7531	RJQ(K)=R(K+2,KNT)
6531	M=1
	EDX=-1
	IF(JA.EQ.222)GO TO 72
	IF(JA.EQ.2222)GO TO 73
	DO 5532 K=1,20
5532	JQ(K)=RJQ(K)
CC	J2=R2  DOES THIS AT 60
CP7542	IF(I1.EQ.IP)GO TO 590
C  X22= ITEM# WHEN EDITING OR DELETING.
	IF(X22.NE.0)GO TO 5511
	IF(JA.GT.0)GO TO 155
	IF(R2.EQ.0)GO TO 5505
C  FOR UP, DOWN, LEFT, RIGHT
	RJJ2=J2
	GO TO 6221
C  GOES BACK IF NEGATIVE AND NOT IN EDIT MODE.
155	IF(JA.EQ.22)GO TO 42  
	IF(JA.EQ.44)GO TO 44
C  THIS '44' IS SET IN 'EDIT' - IT'S NEVER TYPED.
	IF(JA.EQ.55)GO TO 554
	IF(JA.NE.19)GO TO 60
271	CALL HOMER
	GO TO 8853
33	IF(X22.EQ.0)GO TO 6333
C  WHEN NOT IN EDIT MODE(X22=0) "P n n2" LISTS ALL PARAMS FOR ITEMS n→n2.
	J2=R2
	TYPE 331,J2,RJJ(J2-2)
C  TYPE P n TO SEE FULL CONTENTS OF PARAM. n.
	GO TO 5505
331	FORMAT(I,F15.5)

24	IF(X22.NE.0)GO TO 5505
	JA=24
C  CAN'T DO ZOOM WHILE IN EDIT MODE
	IGO=0
CC	CALL HYDPOG(2)
C  TO ERASE SPACING SCALE.
CC	IF(X22.EQ.0)GO TO 23
CC	R2=RHORZ(RN(MEDIT+3))
CC	M=RN(MEDIT+2)
CC	R4=RN(MEDIT+4)*RSTFAC(M)+STFF(M)
CC	ITEM=ITEM-1
C  PICKS UP POINT FROM CURSOR IN 'BOX'
CC	CALL CLRCUR
CC	X22=0
CC	GO TO 241
23	IF(R2.LT.100)GO TO 2410
C%%%%	R5=AMOD(R2,100.)
C%%%%	R2=(R2-R5)/100.
C%%%%	R3=1000.*R5-500.
	R3=AMOD(R2,100.)
	R2=(R2-R3)/100.
	R4=R2*6-R2
C TYPE 24 200.5 FOR 1ST HALF OF DOUBLE, 301 FOR LAST THIRD OF TRIPLE
2410	IF(R2.NE.0)GO TO 241
	IGO=-1
243	R2=1.
C TO REDISPLAY WITH MAGNIFICATION - OR JUST RUN THROUGH DATA.
241	RSZ=.845*R2
	JCEN=(R3*10-500)*RSZ
	KCEN=(R4*10-480)*RSZ
C  NEXT TO RECONSTITUTE SPACING SCALE.
	IF(R2.GT.1)GO TO 240 
	JCEN=0
	KCEN=0
	IF(R2.EQ.1)GO TO 3312
240	R2=(R4-100.)/100.
C%%%%%%%%%%%%%
	IF(R2.LT.0)R2=0
C  WE DON'T WORRY IF IT'S TOO HIGH (YET).
3312	R4=0
	R2=R2+1
	CALL SCL
	R2=0
	R3=0
	R4=0
	LCEN=0
	MCEN=0
C IF P5 ≠ 0 GOES THROUGH DATA IN OLD WAY.
	JFONT=0
85	M=1
	I=PWDS(ITEM+1)
	ITEM=0
8552	ST2=3
8852	PLT=1
	EDX=0
	CALL ACCPOG(1)
	IF(JA.EQ.0)GO TO 6120
	IF(JA.NE.24)IGO=0
	GO TO 6120

6333	CALL LISTP(LST)
	GO TO 5505

172	CALL JUGGLE
	CALL CLRCUR
	CALL DPYNEW
	IF(JA.EQ.22)GO TO 424
C  FOR MOVING DIRECTLY TO NEW ITEM IN EDIT MODE.
	IF(ZERO)GO TO 55
	X22=ZERO
	ZERO=-1
	IF(JA.EQ.55)GO TO 554
	IF(JA.EQ.44)GO TO 44
	IF(KED.NE.0)GO TO 244
	GO TO 425

C  55,POS  -- SETS UP ALIGNMENT
554	CALL BOX(-1,R2)
	IF(J4.EQ.0)KED=-1
	RITEM=R4
C  FOR 'ED POS., STF., CODE#'
	IF(J3.GT.4)KED=-2
	RLINE=R2
	R2=R3
	GO TO 45

C  '22,0' EDITS LAST ITEM ENTERED
42	REDIT=999.0
	IF(R2.NE.0)GO TO 242
	X22=ITEM
	GO TO 429
44	KED=1	
	RITEM=R3
C  'ST', STF#, CODE# (IF 0, ALL ITEMS COME UP) - STF>7 = ALL STAVES.
	IF(R2.GT.7)KED=2
45	REDIT=R2
C  THE STAFF #
	JED=1
244	X=ITEM  
	IF(JED.GT.X)GO TO 444
	DO 144 K=JED,X
	L=PWDS(K)
	IF(KED.EQ.-2)GO TO 654
C  -2 LOOKS AT ALL ITEMS NEAR VERT. LINE, -1 ON SINGLE STAFF.
	IF(KED.EQ.2)GO TO 656
	IF(RN(L+2).NE.REDIT)GO TO 144
	IF(KED)GO TO 654
	IF(RITEM.EQ.0)GO TO 655
656	IF(RITEM.NE.RN(L+1))GO TO 144
655	IF(JA.NE.55)GO TO 344
654	IF(ABS(RLINE-RN(L+3)).LT.5.0)GO TO 344
144	CONTINUE
444	REDIT=999.
C  NO MORE ON LINE
	R2=0
C   SO IT WILL RETURN IF NOTHING IS FOUND WITH 'ED' OR 'ST'.
	GO TO 73
344	JED=K+1
C  FOR NEXT TIME AROUND
	X22=K
	GO TO 429
C  CR MOVES ALONG GIVEN LINE,  222 LEAVES THIS MODE

91	CALL ACCPOG(1)
	IF(I.EQ.IX)ITEM=ITEM-1
	GO TO 142
242	IF(X22.GT.0)GO TO 5511
142	IF(R2.NE.0)GO TO 424
	IF(REDIT.EQ.999)GO TO 1554
	IF(JA.GE.0)GO TO 244
1554	X22=X22+1
	IF(JA)X22=X22-1+JA
	IF(X22.LT.1)X22=1
	GO TO 425
427	FORMAT(1XA5/,2F6.0,F10.2,$)
4271	FORMAT('+  (',I2,')',F7.2,$)

C  FOR EDITING
5511	IF(JA.EQ.55)GO TO 420
220	IF(JA.NE.22)GO TO 720
C  'I, #' WILL MOVE TO ANOTHER ITEM WHEN ALREADY IN EDIT MODE.
	KED=0
	JED=0
	GO TO 72
720	IF(JA.EQ.44)GO TO 420
C  FOR '24' WHILE IN EDIT MODE.  MAGS WITH CURSOR AS CENTER.
	IF(JA.GT.100)GO TO 4221
	IF(JA.GT.13)GO TO 5505
C  PARAM NUM TOO HIGH?  LOOKS FOR NEXT ITEM TO EDIT IF <CR>
4221	IF(X22.EQ.0)GO TO 5517
	IF(R2.NE.0)GO TO 5517
C  BACKS UP WHEN IN EDIT MODE.

	IF(JA.GT.0)GO TO 5518
	IF(I.EQ.IX)GO TO 91
	ZERO=X22+1
C  '0' AFTER AN EDIT ENDS THE EDIT AND GETS NEXT ITEM FOR EDIT.
72	IF(X22.EQ.0)GO TO 55
	IF(KED.EQ.0)REDIT=999.
320	IF(I.NE.IX)GO TO 172
	ITEM=ITEM-1
C  TO DELETE AN ITEM
73	X22=0 
	CALL CLRCUR
	CALL DPYNEW
	IF(REDIT.EQ.999.)GO TO 428
	IF(JA.EQ.55)GO TO 554
	IF(JA.EQ.44)GO TO 44
428	IF(R2.EQ.0.OR.R2.GT.ITEM)GO TO 55
C  DELETION IN EDIT MODE DOES NOT LEAVE MODE.
424	X22=R2
425	IF(X22.GT.ITEM)GO TO 73
C  LEAVES EDIT MODE.
429	IX=I
	MEDIT=PWDS(X22)
	J=2
426	Y=RN(MEDIT)+J
	CALL LOOP(0,Y,1,I,MEDIT,RN)
	JJA=RN(I+1)
	YED=Y-2
	L=I+2
	DO 422 K=1,11
	IF(K.GT.YED)GO TO 423
	RJJ(K)=RN(L+K)
	GO TO 422
423	RJJ(K)=0
422	CONTINUE
	RJJ2=RN(L)
	IF(IGO.GT.0)GO TO 4231
C  NO BOX WHEN IN GROUP EDIT ROUTINE
	IBOX=I
	RBOX=RJJ2
	CALL BOX(IBOX,RBOX)
4231	ITEM=ITEM+1
	ST2=WDS(ITEM)
	GO TO 55

5517	IF(JA.EQ.0)GO TO 6221
5518	X=100-JA
	IF(X)JA=JA/100
	IF(JA.LE.2)GO TO 7221
	IF(JA.LE.13)GO TO 324
	JA=JA/10
C ADD 1000 TO PARAM TO MAKE EQUAL TO ANOTHER PARAM
	X=R2-2.
	RJJ(JA-2)=RJJ(X)
	GO TO 6222
324	I1=JA-2
	IF(X)GO TO 224
	RJJ(I1)=R2
	GO TO 6222
224	RJJ(I1)=RJJ(I1)+R2
	GO TO 6222

7555	CALL MOVER
	IF(R2.EQ.99)GO TO 59
C   99=BACKUP OUT OF MOVER ETC.
	IGO=0
	JFONT=0
C  SO IT WON'T DO ALL FONT LOOKUPS.
8853	IF(JJ2)GO TO 5505
	M=PWDS(JJ2)
	I=PWDS(ITEM+1)
	ITEM=JJ2-1
	ST2=WDS(JJ2)
C SO IT DOESN'T HAVE TO GO THROUGH ALL ITEMS
	GO TO 8852

420	REDIT=0
211	IF(R2.NE.0)GO TO 320
	IF(KED.GE.0)RLINE=RJ3
	RJ3=RLINE
	GO TO 6222
C  FOR '55' ALIGNING
7221	IF(X)GO TO 4223
	CALL PARCH(JA,JJA,R2)
	GO TO 6222
4223	RJJ2=R2+RJJ2
C  ARRAYS NEED 2O LOCATIONS HERE.
C CHNG PARAMS WITH PAIRS OF NUMS.(EG. 2,122  4,13  5,-2 ETC.)
6222	DO 1222 K=1,20,2
	L=JQ(K)
	IF(L.EQ.0)GO TO 6221
C  '600 2'  WILL ADD 2 TO PARAM 6.  '3000 6' SETS P3=P6.
	RD=RJQ(K+1)
	X=L
	IF(L.LT.100)GO TO 223
	IF(L.LT.2000)GO TO 5223
	X=L/1000
	L=JQ(K+1)-2
	RD=RJJ(L)
	GO TO 2223
5223	X=L/100
	IF(X.EQ.2)GO TO 1223
	RD=RJJ(X-2)+RD
	GO TO 2223
1223	RD=RJJ2+RD
223	IF(X.LE.2)GO TO 3223
2223	RJJ(X-2)=RD
	GO TO 1222
3223	CALL PARCH(X,JJA,RD)
C NOW P1 CAN BE CHANGED IN EDIT MODE -- BE CAREFUL,,,,!!!!!!
1222	CONTINUE
C***  LOOP SET TO 11 (20 IN ARRAY!) ONLY 13 PARAMS POSSIBLE NOW.
6221	DO 5514 K=1,11
	R2=RJJ(K)
	RJQ(K)=R2
5514	JQ(K)=R2
	R2=RJJ2
	JA=JJA
	ITEM=ITEM-1
	IF(ITEM)ITEM=0
	ST2=WDS(ITEM+1)
	I=PWDS(ITEM+1)
	CALL DPYNEW
60	J2=R2
	RSTJ2=RSTFAC(J2)
CL	RD=0
	IF(JA.NE.2)GO TO 163
CJ	IF(R9.EQ.0)GO TO 163
	IF(R8.EQ.0)GO TO 163
	IF(R8.EQ.-1)GO TO 163
C R8=0=AS IS; -1=WHOLE REST; >0=NUMBER OVER REST; -2=CENTERED
	K=ITEM
C  ITEM+1 IS CURRENT ITEM IN QUICK RUN-THROUGHS.
	IF(X22.NE.0)K=X22-1
	RD=1.75*RSTJ2
	L=PWDS(K+2)
	IF(RN(L+1).NE.4)GO TO 164
C  GO ON IF NEXT ISN'T BAR LINE (CODE 4. NEXT FINDS OTHER LINES!!)
	IF(RN(L+2).NE.R2)GO TO 164
	RB=RN(L+3)
	L=PWDS(K)
C  CHECK PREV. AND NEXT ITEM.  IF NOT BAR, DON'T TRY TO CENTER!
	IF(RN(L+1).NE.4)GO TO 164
	IF(RN(L+2).NE.R2)GO TO 164
C  JUMP IF NOT ON SAME STAFF
	RA=RN(L+3)
	R3=RA+(RB-RA)/2-1.75*RSTJ2
164	IF(PLT.EQ.0)GO TO 160 
	RN(PWDS(K+1)+3)=R3
C  ******* A DANGEROUS PLACE.  KEEP TRACK OF THIS
	GO TO 5541

163	IF(JA.EQ.16)GO TO 63
	IF(PLT.NE.0)GO TO 5541
	IF(JA.NE.8)GO TO 70
	IF(R9.NE.1)GO TO 160
	L=7
C  RJQ(7) IS R9
71	RA=RN(MEDIT+L+2)
	TYPE 427,RA
721	FORMAT(' TYPE INST. NAME  '$)
	TYPE 721
	ACCEPT FA5,RD
	RJQ(L)=RD
	IF(RD.NE.' ')GO TO 160
	IF(RN(MEDIT).LT.L)RA=0
C  RESTORES NAME IF THERE WAS ONE ALREADY. ELSE=0
	RJQ(L)=RA
C  WHEN P9=1 ASKS FOR ID NAME FOR THE STAFF (FOR PART EXTRACTOR)
	GO TO 160
CF371	FORMAT(A5,A1,A3)
70	IF(JA.NE.11)GO TO 160
C  ↑↑↑↑ WAS - TO 63
	IF(J10.NE.1)GO TO 160
	L=8
C   P10←1 GETS NAME OF BASIC DRAW FILE, PUTS IT IN P10 (NJR)
	GO TO 71
CC	LASTNM=NJR
CC62	IF(NJR.EQ.0)NJR=LASTNM
C  IF NO NAME ASKED FOR, IT TAKES LAST NAME GIVEN.(SOLVES SORT PROB?)
63	RD=R5
	IF(RD.GE.100)RD=RD-100
C ADD 100 TO SZ TO MAKE TEXT APPEAR IN ALL SEPARATE PARTS OF ORCH. SCORE.
	IF(J10.EQ.0)GO TO 162
	L=ITEM
	IF(X22.NE.0)L=X22-1
	IF(J10.EQ.1)GO TO 263
C ↓↓↓↓ TEMP. FIX TO CNVT TEXT FORMAT TO NEW STYLE.  "10 99"
	IF(J10.NE.99)GO TO 863
	X=PWDS(X22)+6
	DO 563 L=X,X+2
	RB=RN(L)
	K=RB
C  CHECKS TO SEE WHICH FORMAT
563	IF(K.NE.RB)GO TO 663
	GO TO 57
663	DO 763 L=X,X+2
763	RN(L)=RN(L)*100.
	GO TO 57

C  NEXT FOR CENTERING TEXT.  P10>1
863	RB=0
	X=PWDS(L+1)
363	L=L+1
	K=PWDS(L)
	RB=RB+RN(K+9)
C  ADD SPACE NEEDED
	K=PWDS(L+1)
	IF(RN(K+1).NE.16)GO TO 463
	IF(RN(K).EQ.8)GO TO 363
C GO BACK IF MORE LETTERS TO COME
463	R3=R10-(RB-3.4)*RD*RSTJ2/2.
C  +3.4 IS TO COMPENSATE FOR STARTING POS. BEING IN CENTER OF LET.
	R10=0
	IF(RN(X).EQ.8)RN(X+10)=0
	RN(X+3)=R3
C THESE ARE NEEDED FOR ITEMS CENTERED DIRECTLY FROM 'WORDS'
	GO TO 162
263	K=PWDS(L)
	R3=AMOD(RN(K+5),100.)*RSTJ2*RN(K+9)+RN(K+3)
C  AMOD BECAUSE P5+100 IS USED FOR PARTS PROGRAM.
	R4=RN(K+4)
	R5=RN(K+5)
	R2=RN(K+2)
	J2=R2
	L=PWDS(L+1)
	DO 361 JJA=3,5
361	RN(L+JJA)=RJQ(JJA-2)
	RN(L+2)=R2
CCC	RN(PWDS(L+1)+3)=R3
C  PUTS POS. BACK INTO RN ARRAY EVERY TIME.
C  PUTS 13TH(+) LETTER IN RIGHT POS. 
162	IF(PLT.NE.0)GO TO 5541
CX160	IF(EDX.NE.0)GO TO 162
CP	IF(I1.EQ.IP)GO TO 5541
CX162	RJ3=R3
160	RJ3=R3
	JJA=JA
	IF(R8.NE.0)GO TO 161
	IF(JA.EQ.1)R8=999.
C  999=0 FOR STEM EXTENSIONS.
CL161	CNT=1
CL	DO 5543 K=1,9
C  10/6/73 ABOVE WAS ,11
CL	RA=RJQ(K)
CL	IF(RA.NE.0)CNT=K
CL5543	RJJ(K)=RA
C  USES ONLY 10 PARAMETERS BEYOND JA, J2
161	CALL MSSLUP
CP2554	IF(PLT.NE.0)GO TO 5541
	IF(JA.NE.6)GO TO 1261
	IF(J13.EQ.0)GO TO 171
	R2=X22
	X22=0
	R3=R13
	J3=J13
	R4=R11
C  RESET HOMING RANGE (DEFAULT=3) WITH P11.
	CALL CLRCUR
	R13=0
C  TYPE 13, n WITH BEAMS TO ADJUST IN RE. TO OTHER STAFF(LIKE OLD 'AD')
	JA=19
	GO TO 271
171	CALL HOMER
CC	IF(JA.NE.13)GO TO 1261
CC	IF(J6.NE.0)R13=-1

1261	IF(R13.EQ.0)GO TO 261
	RD=R11
	CALL HOMER
	R11=RD
C  R11 GETS CHANGED IN 'HOMER'
	IF(JA.EQ.10)R3=R3+RSTJ2
	IF(JA.NE.9)GO TO 261
	IF(J5.GT.3)GO TO 261
	CALL NOZERO(R6)
	R3=R3+RSTJ2+2.*RSTJ2*R6
C ABOVE HELPS CENTER NUMBERS UNDER NOTES(BECAUSE R3 IS AT CENTR OF NUM)
C  IF P13≠0 ANY ITEM WILL LINE UP WITH ANY OTHER ITEM. P13 IS RESET=0
C  P13=-1 POSITIONS ITEM ABOVE OR BELOW NOTE, =-2 JUST BEYOND STEM.
C CODE 10 (NUMBERS) SPACED TO LEFT AS WELL AS CODE 9, P5=1,2,3 (FLAT,SHRP,NAT)
C **** FOR '0' EDITS ******
CL261	RN(I)=CNT
CL	RN(I+1)=JA
CL	I=I+2
CL	RN(I)=R2
CL	IF(RD.NE.0)RN(I)=RD
C TO SAVE NOTE NUMBS IN P2.
CL	DO 4554 K=1,CNT
CL4554	RN(I+K)=RJQ(K)
CL3554	I=CNT+1+I
261	CALL LUP2
5541	IF(DP(J2))GO TO 57
C*** 3/74  NEW DP SYSTEM
C  WHAT ABOUT EDITS?*******
	POS=STFF(J2)
	RX3=R3
C  SAVES IT IN RJQ(20) FOR OTHER ROUTINES.
	J3=ROFF(RHORZ(R3))
C  LINE IS DIVIDED INTO 200 POINTS.
	CALL CENTX
C  SETS VERT.(CENTR) POSITION BASED ON STAFF AND R4
	R3=J3
	IF(JA.LE.2)GO TO 11
551	GO TO(1,1,68,25,67, 625,116,125,11,69, 68,12),JA
	GO TO (116,81,80),JA-15
C  FOR 16,17,18 (WORDS, KSIG, METER)
	IF(JA.EQ.99)GO TO 57
C    FOR PART EXTRACTOR TRANSPOSER - KEY SIG=0
	IF(JA.NE.33.AND.JA.NE.44)GO TO 222
	JA=JA/11
C  THIS IS TEMPORARY - TO READ PAGE TEMP. FILES.
	GO TO 551

222	I=PWDS(ITEM+1)
	GO TO 5505
C  44 1; JFONT=ONE DISPLAYS FONTS - THIS ALSO CATCHES SOME TYPOS

69	CALL MAKNUM(R5)
	GO TO 57

68	CALL CLEFS
	GO TO 57

67	CALL SLUR
	GO TO 57

116	CALL ALPHA
	GO TO 57

81	CALL KSIG
	GO TO 57

80	CALL METER
	GO TO 57

125	IF(R2.EQ.0)RMOV=R8
	CALL STAFF
	GO TO 57
625	CALL BMSTF
	GO TO 57
C   BEAMS, STAFF LINES ****
12	CALL CIRCLE
	GO TO 57

25	CALL ITMSUB
C   BAR LINES, ETC.
	GO TO 57

C  TO GET DISPLAY: 'G'; 'GM'  ADDS TO DPY; 
120	IF(I.EQ.1)GO TO 1220
	IF(I2.NE.IM)GO TO 222
C  'GM'=GET MORE
1220	I1=-1
	CALL NAMEXT(INP,NAME,EXT)
CC1220	CALL FORMAT(NAME)
C  NOW TYPE 'G NAME' OR 'GM NAME'
	IF(NAME.NE.IBL)GO TO 1221
1225	TYPE 21
CF	ACCEPT 371,NAME
	ACCEPT 89,INP
C GO PUT A1'S INTO A5, ETC.
	CALL NAMEXT(INP,NAME,EXT)
	IF(NAME.EQ.'99')GO TO 5505
	IF(NAME.EQ.IBL)GO TO 2220
CF	IF(J.NE.IBL)EXT=J
1221	IF(LOOKX(NAME,EXT).EQ.0)GO TO 1225
C  FUNC. LOOKD IS 'FAIL' PROG. TO CHECK ON LOOKUPS
2220	JA=-1
C  -1 IS FOR 8852+3
2200	J=ITEM+1
	IF(NAME.NE.IBL)GO TO 2207
	CALL GETEXT('TMP','DMD')
	GO TO 2202
2207	CALL GETEXT(NAME,EXT)
2202	CALL EXTIN(RSTFAC,128)
	CALL EXTIN(PWDS(J),JJ2)
	CALL EXTIN(RN(I),IPOS)
	IF(LCNT.GT.1)CALL EXTIN(LIST,LCNT)
C (K) BUG IN FORTRAN UNFORMATTED READ-WRITE. SOMETIMES LAST ITEMS WRONG.
	ITEM=ITEM+JJ2-2
	IF(I2.EQ.IM)GO TO 2203
	I=IPOS
	IF(RSTF.EQ.0)GO TO 85
C  (END OF V ARRAY)RSTF=-1 MEANS READ THE DPY BUFFER 
	CALL EXTIN(ST,4250)
	CALL DPYNEW
	GO TO 5505

2203	M=I-1
	DO 2204 K=J,J+JJ2-2
2204	PWDS(K)=PWDS(K)+M
	GO TO 85
	M=IX
C  IF P5=0 MOVES UP AT START, IF P6=0 MOVES UP AT END.
C  (J8) P8=1 OR 2 FOR 2-PASS PLOTS
C   1.24 AND 1.2 ARE TO FIT 8 1/2 X 11 FORMAT
C RMOV HAS INCHES FROM P8 OF STAFF 0.
C  R6=1 FOR NO MOVE AT END.  R7=INCHES TO MOVE FOR NEW STAFF 0.
C RE. R7:DISTANCE IS MEASURED FROM BOTTOM LINE OF STANDARD POSITION
C OF STAFF 0 UP TO LOWEST!! POINT FOUND IN FOLLOWING FILE.  THEN
C NEXT SHIFT IS AGAIN FROM STANDARD STF.0 TO NEXT FILE'S LOW POINT.
C  MOVES PLOTTER UP IF P5=0.

C  NEXT RUNS THROUGH DATA WITH NEW CHANGES.
6120	IF(M.GE.I)GO TO 7120
	IF(IGO.EQ.0)GO TO 7121
C USE "Z" TO DO FIXUP WHEN LIST IS SCRAMBLED !?X@!ZQ
	IF(M.EQ.PWDS(ITEM+1))GO TO 7121
	K=ITEM+1
	TYPE 7122,K
	PWDS(K)=M
7121	CALL RUNTHR(M)
	IF(EDX.LE.0)GO TO 60
	GO TO 5505
7122	FORMAT(' FIXING ITEM ',I3)

7120	M=1
	IF(PLT.EQ.1)EDX=-1
	PLT=0
	GO TO 5505
C  ALWAYS START PLOT WITH BOTTOM UNIT ON PAGE AND WORK UP.

56	FORMAT(/1XA5,'  TYPE FOR ITEM #',I3,I,I6/)
1	FORMAT(I,24F)
21	FORMAT(' NAME.EXT?  '$)
	END